home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / apollot.lha / apollot_sr10 / float.pas < prev    next >
Pascal/Delphi Source File  |  1989-03-17  |  2KB  |  138 lines
  1. MODULE assist;
  2.  
  3. %nolist;
  4.  
  5. %INCLUDE '/sys/ins/base.ins.pas';
  6. %INCLUDE '/sys/ins/vfmt.ins.pas';
  7. %INCLUDE '/sys/ins/pgm.ins.pas';
  8. %INCLUDE '/sys/ins/pfm.ins.pas';
  9.  
  10. PROCEDURE disk_full;
  11. VAR
  12.     buff:   STRING;
  13. BEGIN
  14.     write( 'Disk is full.  Type Y when files are deleted. ' );        
  15.     read( buff );
  16.  
  17.     IF ( buff[ 1 ] <> 'Y' ) AND ( buff[ 1 ] <> 'y' ) THEN
  18.         pgm_$exit();
  19. END;
  20.  
  21.  
  22.  
  23.  
  24. PROCEDURE gc_interrupt;
  25. VAR
  26.     buff:   STRING;
  27. BEGIN
  28.     write( 'Interrupt during GC.  Exit (Y/N)? ' );        
  29.     read( buff );
  30.  
  31.     IF ( buff[ 1 ] = 'Y' ) OR ( buff[ 1 ] = 'y' ) THEN
  32.         pgm_$exit()
  33.     ELSE
  34.         pfm_$enable();
  35. END;
  36.  
  37.  
  38. { **** Hack-o floating point }
  39.  
  40. PROCEDURE t_$fladd(IN a,b: DOUBLE; OUT c: DOUBLE);
  41. BEGIN
  42.     c := a + b;
  43. END;
  44.  
  45. PROCEDURE t_$flsubtract(IN a,b: DOUBLE; OUT c: DOUBLE);
  46. BEGIN
  47.     c := a - b;
  48. END;
  49.  
  50. PROCEDURE t_$flmultiply(IN a,b: DOUBLE; OUT c: DOUBLE);
  51. BEGIN
  52.     c := a * b;
  53. END;
  54.  
  55. PROCEDURE t_$fldivide(IN a,b: DOUBLE; OUT c: DOUBLE);
  56. BEGIN
  57.     c := a / b;
  58. END;
  59.  
  60. PROCEDURE t_$sin(IN a: DOUBLE; OUT b: DOUBLE);
  61. BEGIN
  62.     b := sin(a);
  63. END;
  64.  
  65. PROCEDURE t_$cos(IN a: DOUBLE; OUT b: DOUBLE);
  66. BEGIN
  67.     b := cos(a);
  68. END;
  69.  
  70. PROCEDURE t_$tan(IN a: DOUBLE; OUT b: DOUBLE);
  71. BEGIN
  72.     b := sin(a)/cos(a);
  73. END;
  74.  
  75. PROCEDURE t_$atan(IN a: DOUBLE; OUT b: DOUBLE);
  76. BEGIN
  77.     b := arctan(a);
  78. END;
  79.                     
  80. PROCEDURE t_$exp(IN a: DOUBLE; OUT b: DOUBLE);
  81. BEGIN
  82.     b := exp(a);
  83. END;
  84.  
  85. PROCEDURE t_$log(IN a: DOUBLE; OUT b: DOUBLE);
  86. BEGIN
  87.     b := ln(a);
  88. END;
  89.  
  90. PROCEDURE t_$sqrt(IN a: DOUBLE; OUT b: DOUBLE);
  91. BEGIN
  92.     b := sqrt(a);
  93. END;
  94.  
  95. FUNCTION t_$flless(IN a,b: DOUBLE): INTEGER;
  96. BEGIN
  97.     IF (a < b) THEN t_$flless := 1 ELSE t_$flless := 0;
  98. END;
  99.  
  100. FUNCTION t_$flequal(IN a,b: DOUBLE): INTEGER;
  101. BEGIN
  102.     IF (a = b) THEN t_$flequal := 1 ELSE t_$flequal := 0;
  103. END;
  104.  
  105. FUNCTION t_$flgreater(IN a,b: DOUBLE): INTEGER;
  106. BEGIN
  107.     IF (a > b) THEN t_$flgreater := 1 ELSE t_$flgreater := 0;
  108. END;
  109.  
  110. FUNCTION t_$fix (IN a: DOUBLE): INTEGER32;
  111. BEGIN
  112.     t_$fix := trunc(a);
  113. END;
  114.  
  115. PROCEDURE t_$float (IN a: INTEGER32; OUT c: DOUBLE);
  116. BEGIN
  117.     c := a;
  118. END;
  119.  
  120. PROCEDURE t_$atod (IN a: STRING; OUT c: DOUBLE);
  121. VAR
  122.     st: status_$t;
  123.     dummy: integer;
  124. BEGIN
  125.     dummy := vfmt_$decode2( '%50ELF%$', a, 50, dummy, st, c, 0);
  126. END;
  127.  
  128. PROCEDURE t_$dtoa (OUT a: STRING; IN c: DOUBLE);
  129. VAR
  130.     st: status_$t;                             
  131.     dummy: integer;
  132. BEGIN
  133.     vfmt_$encode2( '%23.15JLE%$', a, 23, dummy, c, 0 );
  134. END;
  135.  
  136.  
  137.  
  138.